home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / adaMode.tcl next >
Encoding:
Text File  |  1997-12-08  |  3.3 KB  |  98 lines  |  [TEXT/ALFA]
  1.  
  2. alpha::mode Ada 1.0 dummyAda {*.ada *.ads *.adb *.ADS *.ADB *_.a *.a } 
  3.  
  4. #===============================================================================
  5. # From Raymond Waldrop <rwaldrop@cs.tamu.edu>
  6. #===============================================================================
  7.  
  8. newPref f elecRBrace {1} Ada
  9. newPref v leftFillColumn {3} Ada
  10. newPref v prefixString {-- } Ada 
  11. newPref f electricSemi {1} Ada
  12. newPref v wordBreak {[a-zA-Z0-9_]+} Ada
  13. newPref f elecLBrace {1} Ada
  14. newPref f wordWrap {0} Ada
  15. newPref v funcExpr {^[ \t]*(procedure|function)[ \t]+([A-Za-z][A-Za-z0-9_]*)} Ada
  16. newPref v parseExpr {^[ \t]*[^ \t]+[ \t]+([A-Za-z][A-Za-z0-9_]*)} Ada
  17. newPref v wordBreakPreface {[^a-zA-Z0-9_]} Ada
  18. newPref f electricTab {0} Ada
  19.  
  20. # Don't get used!
  21. #set adaCommentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  22. #set adaPreRegexp        {^\#[\t ]*[a-z]*}
  23. set adaKeyWords        {
  24.     abort abs accept access all and array at begin body case constant
  25.     declare delay delta digits do else elsif end entry exception exit
  26.     for function generic goto others if in is limited loop mod new not
  27.     null of or subtype out package pragma private procedure raise range
  28.     record rem renames return reverse select separate task terminate
  29.     then type use when while with xor = /=  := > < abstract aliased 
  30.     protected requeue tagged until
  31.     }
  32. regModeKeywords -e {--} -c magenta -k blue Ada $adaKeyWords -i ")" -i "(" -i ":" -i ";" -i "," -i "." -I blue
  33.  
  34. proc dummyAda {} {}
  35.  
  36. #===============================================================================
  37. # From Tom Konantz
  38. #===============================================================================
  39.  
  40. proc Ada::MarkFile {} {
  41.     global AdamodeVars
  42.     set pos 0
  43.     
  44.     while {![catch {search -s -f 1 -r 1 -m 0 -i 1 $AdamodeVars(funcExpr) $pos} res]} {
  45.         set start [lindex $res 0]
  46.         set end [expr [lindex $res 1] + 1]
  47.         set text [getText $start $end]
  48.                 
  49.         if {[regexp    -nocase    -indices {(procedure|function)[    \t]+([a-zA-Z0-9_]+)} $text dummy dummy0    pname]}    {
  50.             set    i1 [expr [lindex $pname    0]    + $start]
  51.             set    i2    [expr [lindex $pname 1]    + $start + 1]
  52.             set    word  [getText $i1 $i2]
  53.             set    tmp    [concat    $i1    $i2]
  54.             
  55.             if {[info exists cnts($word)]} {
  56.                 # This section handles duplicate. i.e., overloaded names
  57.                 set cnts($word) [expr $cnts($word) + 1]
  58.                 set ol_word [ join [concat $word "#" $cnts($word)] ""]
  59.                 set inds($ol_word) $tmp
  60.             } else {
  61.                 set cnts($word) 1
  62.                 set inds($word) $tmp
  63.             }
  64.         }
  65.  
  66.     
  67.         set pos $end
  68.     }
  69.     if {[info exists inds]} {
  70.       foreach f [lsort -ignore [array names inds]] {
  71.             set res $inds($f)
  72.             setNamedMark $f [lineStart [lindex $res 0]] [lindex $res 0] [lindex $res 1]
  73.         }
  74.     }
  75. }
  76.  
  77. # the following will switch between the Ada spec & body,
  78. # assuming they're in the same directory
  79. # and use either GNAT or VAX Ada naming conventions.
  80. # other conventions can be supported fairly easily.
  81. proc otherPart {} {
  82.     set curname [win::Current]
  83.     if {[regsub  "(.*)\.ads" $curname {\1.adb} tgtname]}  {
  84.         openFileQuietly $tgtname
  85.     } elseif  {[regsub  "(.*)\.adb" $curname {\1.ads} tgtname]}  {
  86.         openFileQuietly $tgtname
  87.     # Next clause must precede the one after it!
  88.     } elseif  {[regsub  {(.*)_\.a$} $curname {\1.a} tgtname]}  {
  89.         openFileQuietly $tgtname
  90.     } elseif  {[regsub  {(.*)\.a$} $curname {\1_.a} tgtname]}  {
  91.         openFileQuietly $tgtname
  92.     } else {
  93.          error "NoMatch"
  94.     }
  95. }
  96.  
  97. bind f9 otherPart Ada
  98.